home *** CD-ROM | disk | FTP | other *** search
/ Nautilus 1992 July / Nautilus-3-8 / Nautilus-3-8.bin / Tools & Utilities / Techy Stuff / Development Environments ƒ / Perl 4.0.2 ƒ / consarg.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-01-05  |  28.7 KB  |  1,303 lines
  1. /* $RCSfile: consarg.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:21:16 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    consarg.c,v $
  9.  * Revision 4.0.1.3  91/11/05  16:21:16  lwall
  10.  * patch11: random cleanup
  11.  * patch11: added eval {}
  12.  * patch11: added sort {} LIST
  13.  * patch11: "foo" x -1 dumped core
  14.  * patch11: substr() and vec() weren't allowed in an lvalue list
  15.  * 
  16.  * Revision 4.0.1.2  91/06/07  10:33:12  lwall
  17.  * patch4: new copyright notice
  18.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  19.  * 
  20.  * Revision 4.0.1.1  91/04/11  17:38:34  lwall
  21.  * patch1: fixed "Bad free" error
  22.  * 
  23.  * Revision 4.0  91/03/20  01:06:15  lwall
  24.  * 4.0 baseline.
  25.  * 
  26.  */
  27.  
  28. #include "EXTERN.h"
  29. #include "perl.h"
  30. static int nothing_in_common();
  31. static int arg_common();
  32. static int spat_common();
  33.  
  34. ARG *
  35. make_split(stab,arg,limarg)
  36. register STAB *stab;
  37. register ARG *arg;
  38. ARG *limarg;
  39. {
  40.     register SPAT *spat;
  41.  
  42.     if (arg->arg_type != O_MATCH) {
  43.     Newz(201,spat,1,SPAT);
  44.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  45.     curstash->tbl_spatroot = spat;
  46.  
  47.     spat->spat_runtime = arg;
  48.     arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  49.     }
  50.     Renew(arg,4,ARG);
  51.     arg->arg_len = 3;
  52.     if (limarg) {
  53.     if (limarg->arg_type == O_ITEM) {
  54.         Copy(limarg+1,arg+3,1,ARG);
  55.         limarg[1].arg_type = A_NULL;
  56.         arg_free(limarg);
  57.     }
  58.     else {
  59.         arg[3].arg_flags = 0;
  60.         arg[3].arg_type = A_EXPR;
  61.         arg[3].arg_ptr.arg_arg = limarg;
  62.     }
  63.     }
  64.     else {
  65.     arg[3].arg_flags = 0;
  66.     arg[3].arg_type = A_NULL;
  67.     arg[3].arg_ptr.arg_arg = Nullarg;
  68.     }
  69.     arg->arg_type = O_SPLIT;
  70.     spat = arg[2].arg_ptr.arg_spat;
  71.     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
  72.     if (spat->spat_short) {    /* exact match can bypass regexec() */
  73.     if (!((spat->spat_flags & SPAT_SCANFIRST) &&
  74.         (spat->spat_flags & SPAT_ALL) )) {
  75.         str_free(spat->spat_short);
  76.         spat->spat_short = Nullstr;
  77.     }
  78.     }
  79.     return arg;
  80. }
  81.  
  82. ARG *
  83. mod_match(type,left,pat)
  84. register ARG *left;
  85. register ARG *pat;
  86. {
  87.  
  88.     register SPAT *spat;
  89.     register ARG *newarg;
  90.  
  91.     if (!pat)
  92.     return Nullarg;
  93.  
  94.     if ((pat->arg_type == O_MATCH ||
  95.      pat->arg_type == O_SUBST ||
  96.      pat->arg_type == O_TRANS ||
  97.      pat->arg_type == O_SPLIT
  98.     ) &&
  99.     pat[1].arg_ptr.arg_stab == defstab ) {
  100.     switch (pat->arg_type) {
  101.     case O_MATCH:
  102.         newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
  103.         pat->arg_len,
  104.         left,Nullarg,Nullarg);
  105.         break;
  106.     case O_SUBST:
  107.         newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
  108.         pat->arg_len,
  109.         left,Nullarg,Nullarg));
  110.         break;
  111.     case O_TRANS:
  112.         newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
  113.         pat->arg_len,
  114.         left,Nullarg,Nullarg));
  115.         break;
  116.     case O_SPLIT:
  117.         newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
  118.         pat->arg_len,
  119.         left,Nullarg,Nullarg);
  120.         break;
  121.     }
  122.     if (pat->arg_len >= 2) {
  123.         newarg[2].arg_type = pat[2].arg_type;
  124.         newarg[2].arg_ptr = pat[2].arg_ptr;
  125.         newarg[2].arg_len = pat[2].arg_len;
  126.         newarg[2].arg_flags = pat[2].arg_flags;
  127.         if (pat->arg_len >= 3) {
  128.         newarg[3].arg_type = pat[3].arg_type;
  129.         newarg[3].arg_ptr = pat[3].arg_ptr;
  130.         newarg[3].arg_len = pat[3].arg_len;
  131.         newarg[3].arg_flags = pat[3].arg_flags;
  132.         }
  133.     }
  134.     free_arg(pat);
  135.     }
  136.     else {
  137.     Newz(202,spat,1,SPAT);
  138.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  139.     curstash->tbl_spatroot = spat;
  140.  
  141.     spat->spat_runtime = pat;
  142.     newarg = make_op(type,2,left,Nullarg,Nullarg);
  143.     newarg[2].arg_type = A_SPAT | A_DONT;
  144.     newarg[2].arg_ptr.arg_spat = spat;
  145.     }
  146.  
  147.     return newarg;
  148. }
  149.  
  150. ARG *
  151. make_op(type,newlen,arg1,arg2,arg3)
  152. int type;
  153. int newlen;
  154. ARG *arg1;
  155. ARG *arg2;
  156. ARG *arg3;
  157. {
  158.     register ARG *arg;
  159.     register ARG *chld;
  160.     register unsigned doarg;
  161.     register int i;
  162.     extern ARG *arg4;    /* should be normal arguments, really */
  163.     extern ARG *arg5;
  164.  
  165.     arg = op_new(newlen);
  166.     arg->arg_type = type;
  167.     /*SUPPRESS 560*/
  168.     if (chld = arg1) {
  169.     if (chld->arg_type == O_ITEM &&
  170.         (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
  171.          (i == A_LEXPR &&
  172.           (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  173.            chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  174.            chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
  175.     {
  176.         arg[1].arg_type = chld[1].arg_type;
  177.         arg[1].arg_ptr = chld[1].arg_ptr;
  178.         arg[1].arg_flags |= chld[1].arg_flags;
  179.         arg[1].arg_len = chld[1].arg_len;
  180.         free_arg(chld);
  181.     }
  182.     else {
  183.         arg[1].arg_type = A_EXPR;
  184.         arg[1].arg_ptr.arg_arg = chld;
  185.     }
  186.     }
  187.     /*SUPPRESS 560*/
  188.     if (chld = arg2) {
  189.     if (chld->arg_type == O_ITEM && 
  190.         (hoistable[chld[1].arg_type&A_MASK] || 
  191.          (type == O_ASSIGN && 
  192.           ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  193.         ||
  194.            (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
  195.         ||
  196.            (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
  197.           ) ) ) ) {
  198.         arg[2].arg_type = chld[1].arg_type;
  199.         arg[2].arg_ptr = chld[1].arg_ptr;
  200.         arg[2].arg_len = chld[1].arg_len;
  201.         free_arg(chld);
  202.     }
  203.     else {
  204.         arg[2].arg_type = A_EXPR;
  205.         arg[2].arg_ptr.arg_arg = chld;
  206.     }
  207.     }
  208.     /*SUPPRESS 560*/
  209.     if (chld = arg3) {
  210.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  211.         arg[3].arg_type = chld[1].arg_type;
  212.         arg[3].arg_ptr = chld[1].arg_ptr;
  213.         arg[3].arg_len = chld[1].arg_len;
  214.         free_arg(chld);
  215.     }
  216.     else {
  217.         arg[3].arg_type = A_EXPR;
  218.         arg[3].arg_ptr.arg_arg = chld;
  219.     }
  220.     }
  221.     if (newlen >= 4 && (chld = arg4)) {
  222.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  223.         arg[4].arg_type = chld[1].arg_type;
  224.         arg[4].arg_ptr = chld[1].arg_ptr;
  225.         arg[4].arg_len = chld[1].arg_len;
  226.         free_arg(chld);
  227.     }
  228.     else {
  229.         arg[4].arg_type = A_EXPR;
  230.         arg[4].arg_ptr.arg_arg = chld;
  231.     }
  232.     }
  233.     if (newlen >= 5 && (chld = arg5)) {
  234.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  235.         arg[5].arg_type = chld[1].arg_type;
  236.         arg[5].arg_ptr = chld[1].arg_ptr;
  237.         arg[5].arg_len = chld[1].arg_len;
  238.         free_arg(chld);
  239.     }
  240.     else {
  241.         arg[5].arg_type = A_EXPR;
  242.         arg[5].arg_ptr.arg_arg = chld;
  243.     }
  244.     }
  245.     doarg = opargs[type];
  246.     for (i = 1; i <= newlen; ++i) {
  247.     if (!(doarg & 1))
  248.         arg[i].arg_type |= A_DONT;
  249.     if (doarg & 2)
  250.         arg[i].arg_flags |= AF_ARYOK;
  251.     doarg >>= 2;
  252.     }
  253. #ifdef DEBUGGING
  254.     if (debug & 16) {
  255.     fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
  256.     if (arg1)
  257.         fprintf(stderr,",%s=%lx",
  258.         argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
  259.     if (arg2)
  260.         fprintf(stderr,",%s=%lx",
  261.         argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
  262.     if (arg3)
  263.         fprintf(stderr,",%s=%lx",
  264.         argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
  265.     if (newlen >= 4)
  266.         fprintf(stderr,",%s=%lx",
  267.         argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
  268.     if (newlen >= 5)
  269.         fprintf(stderr,",%s=%lx",
  270.         argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
  271.     fprintf(stderr,")\n");
  272.     }
  273. #endif
  274.     arg = evalstatic(arg);    /* see if we can consolidate anything */
  275.     return arg;
  276. }
  277.  
  278. #ifdef macintosh
  279. #include <Math.h>
  280. #endif
  281.  
  282. ARG *
  283. evalstatic(arg)
  284. register ARG *arg;
  285. {
  286.     static STR *str = Nullstr;
  287.     register STR *s1;
  288.     register STR *s2;
  289.     double value;        /* must not be register */
  290.     register char *tmps;
  291.     int i;
  292.     unsigned long tmplong;
  293.     long tmp2;
  294.     char *crypt();
  295. #ifndef macintosh
  296.     double exp(), log(), sqrt(), modf();
  297.     double sin(), cos(), atan2(), pow();
  298. #endif
  299.  
  300.     if (!arg || !arg->arg_len)
  301.     return arg;
  302.  
  303.     if (!str)
  304.     str = Str_new(20,0);
  305.  
  306.     if (arg[1].arg_type == A_SINGLE)
  307.     s1 = arg[1].arg_ptr.arg_str;
  308.     else
  309.     s1 = Nullstr;
  310.     if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
  311.     s2 = arg[2].arg_ptr.arg_str;
  312.     else
  313.     s2 = Nullstr;
  314.  
  315. #define CHECK1 if (!s1) return arg
  316. #define CHECK2 if (!s2) return arg
  317. #define CHECK12 if (!s1 || !s2) return arg
  318.  
  319.     switch (arg->arg_type) {
  320.     default:
  321.     return arg;
  322.     case O_SORT:
  323.     if (arg[1].arg_type == A_CMD)
  324.         arg[1].arg_type |= A_DONT;
  325.     return arg;
  326.     case O_EVAL:
  327.     if (arg[1].arg_type == A_CMD) {
  328.         arg->arg_type = O_TRY;
  329.         arg[1].arg_type |= A_DONT;
  330.         return arg;
  331.     }
  332.     CHECK1;
  333.     arg->arg_type = O_EVALONCE;
  334.     return arg;
  335.     case O_AELEM:
  336.     CHECK2;
  337.     i = (int)str_gnum(s2);
  338.     if (i < 32767 && i >= 0) {
  339.         arg->arg_type = O_ITEM;
  340.         arg->arg_len = 1;
  341.         arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
  342.         arg[1].arg_len = i;
  343.         str_free(s2);
  344.         Renew(arg, 2, ARG);
  345.     }
  346.     return arg;
  347.     case O_CONCAT:
  348.     CHECK12;
  349.     str_sset(str,s1);
  350.     str_scat(str,s2);
  351.     break;
  352.     case O_REPEAT:
  353.     CHECK12;
  354.     i = (int)str_gnum(s2);
  355.     tmps = str_get(s1);
  356.     str_nset(str,"",0);
  357.     if (i > 0) {
  358.         STR_GROW(str, i * s1->str_cur + 1);
  359.         repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
  360.         str->str_cur = i * s1->str_cur;
  361.         str->str_ptr[str->str_cur] = '\0';
  362.     }
  363.     break;
  364.     case O_MULTIPLY:
  365.     CHECK12;
  366.     value = str_gnum(s1);
  367.     str_numset(str,value * str_gnum(s2));
  368.     break;
  369.     case O_DIVIDE:
  370.     CHECK12;
  371.     value = str_gnum(s2);
  372.     if (value == 0.0)
  373.         yyerror("Illegal division by constant zero");
  374.     else
  375. #ifdef SLOPPYDIVIDE
  376.     /* insure that 20./5. == 4. */
  377.     {
  378.         double x;
  379.         int    k;
  380.         x =  str_gnum(s1);
  381.         if ((double)(int)x     == x &&
  382.         (double)(int)value == value &&
  383.         (k = (int)x/(int)value)*(int)value == (int)x) {
  384.         value = k;
  385.         } else {
  386.         value = x/value;
  387.         }
  388.         str_numset(str,value);
  389.     }
  390. #else
  391.     str_numset(str,str_gnum(s1) / value);
  392. #endif
  393.     break;
  394.     case O_MODULO:
  395.     CHECK12;
  396.     tmplong = (unsigned long)str_gnum(s2);
  397.     if (tmplong == 0L) {
  398.         yyerror("Illegal modulus of constant zero");
  399.         return arg;
  400.     }
  401.     tmp2 = (long)str_gnum(s1);
  402. #ifndef lint
  403.     if (tmp2 >= 0)
  404.         str_numset(str,(double)(tmp2 % tmplong));
  405.     else
  406.         str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  407. #else
  408.     tmp2 = tmp2;
  409. #endif
  410.     break;
  411.     case O_ADD:
  412.     CHECK12;
  413.     value = str_gnum(s1);
  414.     str_numset(str,value + str_gnum(s2));
  415.     break;
  416.     case O_SUBTRACT:
  417.     CHECK12;
  418.     value = str_gnum(s1);
  419.     str_numset(str,value - str_gnum(s2));
  420.     break;
  421.     case O_LEFT_SHIFT:
  422.     CHECK12;
  423.     value = str_gnum(s1);
  424.     i = (int)str_gnum(s2);
  425. #ifndef lint
  426.     str_numset(str,(double)(((long)value) << i));
  427. #endif
  428.     break;
  429.     case O_RIGHT_SHIFT:
  430.     CHECK12;
  431.     value = str_gnum(s1);
  432.     i = (int)str_gnum(s2);
  433. #ifndef lint
  434.     str_numset(str,(double)(((long)value) >> i));
  435. #endif
  436.     break;
  437.     case O_LT:
  438.     CHECK12;
  439.     value = str_gnum(s1);
  440.     str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
  441.     break;
  442.     case O_GT:
  443.     CHECK12;
  444.     value = str_gnum(s1);
  445.     str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
  446.     break;
  447.     case O_LE:
  448.     CHECK12;
  449.     value = str_gnum(s1);
  450.     str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
  451.     break;
  452.     case O_GE:
  453.     CHECK12;
  454.     value = str_gnum(s1);
  455.     str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
  456.     break;
  457.     case O_EQ:
  458.     CHECK12;
  459.     if (dowarn) {
  460.         if ((!s1->str_nok && !looks_like_number(s1)) ||
  461.         (!s2->str_nok && !looks_like_number(s2)) )
  462.         warn("Possible use of == on string value");
  463.     }
  464.     value = str_gnum(s1);
  465.     str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
  466.     break;
  467.     case O_NE:
  468.     CHECK12;
  469.     value = str_gnum(s1);
  470.     str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
  471.     break;
  472.     case O_NCMP:
  473.     CHECK12;
  474.     value = str_gnum(s1);
  475.     value -= str_gnum(s2);
  476.     if (value > 0.0)
  477.         value = 1.0;
  478.     else if (value < 0.0)
  479.         value = -1.0;
  480.     str_numset(str,value);
  481.     break;
  482.     case O_BIT_AND:
  483.     CHECK12;
  484.     value = str_gnum(s1);
  485. #ifndef lint
  486.     str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  487. #endif
  488.     break;
  489.     case O_XOR:
  490.     CHECK12;
  491.     value = str_gnum(s1);
  492. #ifndef lint
  493.     str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  494. #endif
  495.     break;
  496.     case O_BIT_OR:
  497.     CHECK12;
  498.     value = str_gnum(s1);
  499. #ifndef lint
  500.     str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  501. #endif
  502.     break;
  503.     case O_AND:
  504.     CHECK12;
  505.     if (str_true(s1))
  506.         str_sset(str,s2);
  507.     else
  508.         str_sset(str,s1);
  509.     break;
  510.     case O_OR:
  511.     CHECK12;
  512.     if (str_true(s1))
  513.         str_sset(str,s1);
  514.     else
  515.         str_sset(str,s2);
  516.     break;
  517.     case O_COND_EXPR:
  518.     CHECK12;
  519.     if ((arg[3].arg_type & A_MASK) != A_SINGLE)
  520.         return arg;
  521.     if (str_true(s1))
  522.         str_sset(str,s2);
  523.     else
  524.         str_sset(str,arg[3].arg_ptr.arg_str);
  525.     str_free(arg[3].arg_ptr.arg_str);
  526.     Renew(arg, 3, ARG);
  527.     break;
  528.     case O_NEGATE:
  529.     CHECK1;
  530.     str_numset(str,(double)(-str_gnum(s1)));
  531.     break;
  532.     case O_NOT:
  533.     CHECK1;
  534. #ifdef NOTNOT
  535.     { char xxx = str_true(s1); str_numset(str,(double)!xxx); }
  536. #else
  537.     str_numset(str,(double)(!str_true(s1)));
  538. #endif
  539.     break;
  540.     case O_COMPLEMENT:
  541.     CHECK1;
  542. #ifndef lint
  543.     str_numset(str,(double)(~U_L(str_gnum(s1))));
  544. #endif
  545.     break;
  546.     case O_SIN:
  547.     CHECK1;
  548.     str_numset(str,sin(str_gnum(s1)));
  549.     break;
  550.     case O_COS:
  551.     CHECK1;
  552.     str_numset(str,cos(str_gnum(s1)));
  553.     break;
  554.     case O_ATAN2:
  555.     CHECK12;
  556.     value = str_gnum(s1);
  557.     str_numset(str,atan2(value, str_gnum(s2)));
  558.     break;
  559.     case O_POW:
  560.     CHECK12;
  561.     value = str_gnum(s1);
  562.     str_numset(str,pow(value, str_gnum(s2)));
  563.     break;
  564.     case O_LENGTH:
  565.     if (arg[1].arg_type == A_STAB) {
  566.         arg->arg_type = O_ITEM;
  567.         arg[1].arg_type = A_LENSTAB;
  568.         return arg;
  569.     }
  570.     CHECK1;
  571.     str_numset(str, (double)str_len(s1));
  572.     break;
  573.     case O_SLT:
  574.     CHECK12;
  575.     str_numset(str,(double)(str_cmp(s1,s2) < 0));
  576.     break;
  577.     case O_SGT:
  578.     CHECK12;
  579.     str_numset(str,(double)(str_cmp(s1,s2) > 0));
  580.     break;
  581.     case O_SLE:
  582.     CHECK12;
  583.     str_numset(str,(double)(str_cmp(s1,s2) <= 0));
  584.     break;
  585.     case O_SGE:
  586.     CHECK12;
  587.     str_numset(str,(double)(str_cmp(s1,s2) >= 0));
  588.     break;
  589.     case O_SEQ:
  590.     CHECK12;
  591.     str_numset(str,(double)(str_eq(s1,s2)));
  592.     break;
  593.     case O_SNE:
  594.     CHECK12;
  595.     str_numset(str,(double)(!str_eq(s1,s2)));
  596.     break;
  597.     case O_SCMP:
  598.     CHECK12;
  599.     str_numset(str,(double)(str_cmp(s1,s2)));
  600.     break;
  601.     case O_CRYPT:
  602.     CHECK12;
  603. #ifdef HAS_CRYPT
  604.         tmps = str_get(s1);
  605.         str_set(str,crypt(tmps,str_get(s2)));
  606. #else
  607.         yyerror(
  608.         "The crypt() function is unimplemented due to excessive paranoia.");
  609. #endif
  610.         break;
  611.     case O_EXP:
  612.     CHECK1;
  613.         str_numset(str,exp(str_gnum(s1)));
  614.         break;
  615.     case O_LOG:
  616.     CHECK1;
  617.         str_numset(str,log(str_gnum(s1)));
  618.         break;
  619.     case O_SQRT:
  620.     CHECK1;
  621.         str_numset(str,sqrt(str_gnum(s1)));
  622.         break;
  623.     case O_INT:
  624.     CHECK1;
  625.         value = str_gnum(s1);
  626. #ifdef macintosh
  627.         {
  628.              extended eres;
  629.         if (value >= 0.0)
  630.             (void)modf(value,&eres);
  631.         else {
  632.             (void)modf(-value,&eres);
  633.             eres = -eres;
  634.         }
  635.             str_numset(str,eres);
  636.         }        
  637. #else
  638.         if (value >= 0.0)
  639.         (void)modf(value,&value);
  640.         else {
  641.         (void)modf(-value,&value);
  642.         value = -value;
  643.         }
  644.         str_numset(str,value);
  645. #endif        
  646.         break;
  647.     case O_ORD:
  648.     CHECK1;
  649. #ifndef I286
  650.         str_numset(str,(double)(*str_get(s1)));
  651. #else
  652.         {
  653.         int  zapc;
  654.         char *zaps;
  655.  
  656.         zaps = str_get(s1);
  657.         zapc = (int) *zaps;
  658.         str_numset(str,(double)(zapc));
  659.         }
  660. #endif
  661.         break;
  662.     }
  663.     arg->arg_type = O_ITEM;    /* note arg1 type is already SINGLE */
  664.     str_free(s1);
  665.     arg[1].arg_ptr.arg_str = str;
  666.     if (s2) {
  667.     str_free(s2);
  668.     arg[2].arg_ptr.arg_str = Nullstr;
  669.     arg[2].arg_type = A_NULL;
  670.     }
  671.     str = Nullstr;
  672.  
  673.     return arg;
  674. }
  675.  
  676. ARG *
  677. l(arg)
  678. register ARG *arg;
  679. {
  680.     register int i;
  681.     register ARG *arg1;
  682.     register ARG *arg2;
  683.     SPAT *spat;
  684.     int arghog = 0;
  685.  
  686.     i = arg[1].arg_type & A_MASK;
  687.  
  688.     arg->arg_flags |= AF_COMMON;    /* assume something in common */
  689.                     /* which forces us to copy things */
  690.  
  691.     if (i == A_ARYLEN) {
  692.     arg[1].arg_type = A_LARYLEN;
  693.     return arg;
  694.     }
  695.     if (i == A_ARYSTAB) {
  696.     arg[1].arg_type = A_LARYSTAB;
  697.     return arg;
  698.     }
  699.  
  700.     /* see if it's an array reference */
  701.  
  702.     if (i == A_EXPR || i == A_LEXPR) {
  703.     arg1 = arg[1].arg_ptr.arg_arg;
  704.  
  705.     if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
  706.                         /* assign to list */
  707.         if (arg->arg_len > 1) {
  708.         dehoist(arg,2);
  709.         arg2 = arg[2].arg_ptr.arg_arg;
  710.         if (nothing_in_common(arg1,arg2))
  711.             arg->arg_flags &= ~AF_COMMON;
  712.         if (arg->arg_type == O_ASSIGN) {
  713.             if (arg1->arg_flags & AF_LOCAL)
  714.             arg->arg_flags |= AF_LOCAL;
  715.             arg[1].arg_flags |= AF_ARYOK;
  716.             arg[2].arg_flags |= AF_ARYOK;
  717.         }
  718.         }
  719.         else if (arg->arg_type != O_CHOP)
  720.         arg->arg_type = O_ASSIGN;    /* possible local(); */
  721.         for (i = arg1->arg_len; i >= 1; i--) {
  722.         switch (arg1[i].arg_type) {
  723.         case A_STAR: case A_LSTAR:
  724.             arg1[i].arg_type = A_LSTAR;
  725.             break;
  726.         case A_STAB: case A_LVAL:
  727.             arg1[i].arg_type = A_LVAL;
  728.             break;
  729.         case A_ARYLEN: case A_LARYLEN:
  730.             arg1[i].arg_type = A_LARYLEN;
  731.             break;
  732.         case A_ARYSTAB: case A_LARYSTAB:
  733.             arg1[i].arg_type = A_LARYSTAB;
  734.             break;
  735.         case A_EXPR: case A_LEXPR:
  736.             arg1[i].arg_type = A_LEXPR;
  737.             switch(arg1[i].arg_ptr.arg_arg->arg_type) {
  738.             case O_ARRAY: case O_LARRAY:
  739.             arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
  740.             arghog = 1;
  741.             break;
  742.             case O_AELEM: case O_LAELEM:
  743.             arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
  744.             break;
  745.             case O_HASH: case O_LHASH:
  746.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
  747.             arghog = 1;
  748.             break;
  749.             case O_HELEM: case O_LHELEM:
  750.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
  751.             break;
  752.             case O_ASLICE: case O_LASLICE:
  753.             arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
  754.             break;
  755.             case O_HSLICE: case O_LHSLICE:
  756.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
  757.             break;
  758.             case O_SUBSTR: case O_VEC:
  759.             (void)l(arg1[i].arg_ptr.arg_arg);
  760.             Renewc(arg1[i].arg_ptr.arg_arg->arg_ptr.arg_str, 1,
  761.               struct lstring, STR);
  762.                 /* grow string struct to hold an lstring struct */
  763.             break;
  764.             default:
  765.             goto ill_item;
  766.             }
  767.             break;
  768.         default:
  769.           ill_item:
  770.             (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
  771.               argname[arg1[i].arg_type&A_MASK]);
  772.             yyerror(tokenbuf);
  773.         }
  774.         }
  775.         if (arg->arg_len > 1) {
  776.         if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
  777.             arg2[3].arg_type = A_SINGLE;
  778.             arg2[3].arg_ptr.arg_str =
  779.               str_nmake((double)arg1->arg_len + 1); /* limit split len*/
  780.         }
  781.         }
  782.     }
  783.     else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
  784.         if (arg->arg_type == O_DEFINED)
  785.         arg1->arg_type = O_AELEM;
  786.         else
  787.         arg1->arg_type = O_LAELEM;
  788.     else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
  789.         arg1->arg_type = O_LARRAY;
  790.         if (arg->arg_len > 1) {
  791.         dehoist(arg,2);
  792.         arg2 = arg[2].arg_ptr.arg_arg;
  793.         if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
  794.             spat = arg2[2].arg_ptr.arg_spat;
  795.             if (!(spat->spat_flags & SPAT_ONCE) &&
  796.               nothing_in_common(arg1,spat->spat_repl)) {
  797.             spat->spat_repl[1].arg_ptr.arg_stab =
  798.                 arg1[1].arg_ptr.arg_stab;
  799.             arg1[1].arg_ptr.arg_stab = Nullstab;
  800.             spat->spat_flags |= SPAT_ONCE;
  801.             arg_free(arg1);    /* recursive */
  802.             arg[1].arg_ptr.arg_arg = Nullarg;
  803.             free_arg(arg);    /* non-recursive */
  804.             return arg2;    /* split has builtin assign */
  805.             }
  806.         }
  807.         else if (nothing_in_common(arg1,arg2))
  808.             arg->arg_flags &= ~AF_COMMON;
  809.         if (arg->arg_type == O_ASSIGN) {
  810.             arg[1].arg_flags |= AF_ARYOK;
  811.             arg[2].arg_flags |= AF_ARYOK;
  812.         }
  813.         }
  814.         else if (arg->arg_type == O_ASSIGN)
  815.         arg[1].arg_flags |= AF_ARYOK;
  816.     }
  817.     else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
  818.         if (arg->arg_type == O_DEFINED)
  819.         arg1->arg_type = O_HELEM;    /* avoid creating one */
  820.         else
  821.         arg1->arg_type = O_LHELEM;
  822.     else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
  823.         arg1->arg_type = O_LHASH;
  824.         if (arg->arg_len > 1) {
  825.         dehoist(arg,2);
  826.         arg2 = arg[2].arg_ptr.arg_arg;
  827.         if (nothing_in_common(arg1,arg2))
  828.             arg->arg_flags &= ~AF_COMMON;
  829.         if (arg->arg_type == O_ASSIGN) {
  830.             arg[1].arg_flags |= AF_ARYOK;
  831.             arg[2].arg_flags |= AF_ARYOK;
  832.         }
  833.         }
  834.         else if (arg->arg_type == O_ASSIGN)
  835.         arg[1].arg_flags |= AF_ARYOK;
  836.     }
  837.     else if (arg1->arg_type == O_ASLICE) {
  838.         arg1->arg_type = O_LASLICE;
  839.         if (arg->arg_type == O_ASSIGN) {
  840.         dehoist(arg,2);
  841.         arg[1].arg_flags |= AF_ARYOK;
  842.         arg[2].arg_flags |= AF_ARYOK;
  843.         }
  844.     }
  845.     else if (arg1->arg_type == O_HSLICE) {
  846.         arg1->arg_type = O_LHSLICE;
  847.         if (arg->arg_type == O_ASSIGN) {
  848.         dehoist(arg,2);
  849.         arg[1].arg_flags |= AF_ARYOK;
  850.         arg[2].arg_flags |= AF_ARYOK;
  851.         }
  852.     }
  853.     else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
  854.       (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
  855.         arg[1].arg_type |= A_DONT;
  856.     }
  857.     else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
  858.         (void)l(arg1);
  859.         Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
  860.             /* grow string struct to hold an lstring struct */
  861.     }
  862.     else if (arg1->arg_type == O_ASSIGN)
  863.         /*SUPPRESS 530*/
  864.         ;
  865.     else {
  866.         (void)sprintf(tokenbuf,
  867.           "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
  868.         yyerror(tokenbuf);
  869.     }
  870.     arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
  871.     if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
  872.         arg[1].arg_flags |= AF_ARYOK;
  873.         if (arg->arg_len > 1)
  874.         arg[2].arg_flags |= AF_ARYOK;
  875.     }
  876. #ifdef DEBUGGING
  877.     if (debug & 16)
  878.         fprintf(stderr,"lval LEXPR\n");
  879. #endif
  880.     return arg;
  881.     }
  882.     if (i == A_STAR || i == A_LSTAR) {
  883.     arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
  884.     return arg;
  885.     }
  886.  
  887.     /* not an array reference, should be a register name */
  888.  
  889.     if (i != A_STAB && i != A_LVAL) {
  890.     (void)sprintf(tokenbuf,
  891.       "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
  892.     yyerror(tokenbuf);
  893.     }
  894.     arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
  895. #ifdef DEBUGGING
  896.     if (debug & 16)
  897.     fprintf(stderr,"lval LVAL\n");
  898. #endif
  899.     return arg;
  900. }
  901.  
  902. ARG *
  903. fixl(type,arg)
  904. int type;
  905. ARG *arg;
  906. {
  907.     if (type == O_DEFINED || type == O_UNDEF) {
  908.     if (arg->arg_type != O_ITEM)
  909.         arg = hide_ary(arg);
  910.     if (arg->arg_type == O_ITEM) {
  911.         type = arg[1].arg_type & A_MASK;
  912.         if (type == A_EXPR || type == A_LEXPR)
  913.         arg[1].arg_type = A_LEXPR|A_DONT;
  914.     }
  915.     }
  916.     return arg;
  917. }
  918.  
  919. dehoist(arg,i)
  920. ARG *arg;
  921. {
  922.     ARG *tmparg;
  923.  
  924.     if (arg[i].arg_type != A_EXPR) {    /* dehoist */
  925.     tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
  926.     tmparg[1] = arg[i];
  927.     arg[i].arg_ptr.arg_arg = tmparg;
  928.     arg[i].arg_type = A_EXPR;
  929.     }
  930. }
  931.  
  932. ARG *
  933. addflags(i,flags,arg)
  934. register ARG *arg;
  935. {
  936.     arg[i].arg_flags |= flags;
  937.     return arg;
  938. }
  939.  
  940. ARG *
  941. hide_ary(arg)
  942. ARG *arg;
  943. {
  944.     if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
  945.     return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
  946.     return arg;
  947. }
  948.  
  949. /* maybe do a join on multiple array dimensions */
  950.  
  951. ARG *
  952. jmaybe(arg)
  953. register ARG *arg;
  954. {
  955.     if (arg && arg->arg_type == O_COMMA) {
  956.     arg = listish(arg);
  957.     arg = make_op(O_JOIN, 2,
  958.         stab2arg(A_STAB,stabent(";",TRUE)),
  959.         make_list(arg),
  960.         Nullarg);
  961.     }
  962.     return arg;
  963. }
  964.  
  965. ARG *
  966. make_list(arg)
  967. register ARG *arg;
  968. {
  969.     register int i;
  970.     register ARG *node;
  971.     register ARG *nxtnode;
  972.     register int j;
  973.     STR *tmpstr;
  974.  
  975.     if (!arg) {
  976.     arg = op_new(0);
  977.     arg->arg_type = O_LIST;
  978.     }
  979.     if (arg->arg_type != O_COMMA) {
  980.     if (arg->arg_type != O_ARRAY)
  981.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  982.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  983.     return arg;
  984.     }
  985.     for (i = 2, node = arg; ; i++) {
  986.     if (node->arg_len < 2)
  987.         break;
  988.         if (node[1].arg_type != A_EXPR)
  989.         break;
  990.     node = node[1].arg_ptr.arg_arg;
  991.     if (node->arg_type != O_COMMA)
  992.         break;
  993.     }
  994.     if (i > 2) {
  995.     node = arg;
  996.     arg = op_new(i);
  997.     tmpstr = arg->arg_ptr.arg_str;
  998. #ifdef STRUCTCOPY
  999.     *arg = *node;        /* copy everything except the STR */
  1000. #else
  1001.     (void)bcopy((char *)node, (char *)arg, sizeof(ARG));
  1002. #endif
  1003.     arg->arg_ptr.arg_str = tmpstr;
  1004.     for (j = i; ; ) {
  1005. #ifdef STRUCTCOPY
  1006.         arg[j] = node[2];
  1007. #else
  1008.         (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
  1009. #endif
  1010.         arg[j].arg_flags |= AF_ARYOK;
  1011.         --j;        /* Bug in Xenix compiler */
  1012.         if (j < 2) {
  1013. #ifdef STRUCTCOPY
  1014.         arg[1] = node[1];
  1015. #else
  1016.         (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
  1017. #endif
  1018.         free_arg(node);
  1019.         break;
  1020.         }
  1021.         nxtnode = node[1].arg_ptr.arg_arg;
  1022.         free_arg(node);
  1023.         node = nxtnode;
  1024.     }
  1025.     }
  1026.     arg[1].arg_flags |= AF_ARYOK;
  1027.     arg[2].arg_flags |= AF_ARYOK;
  1028.     arg->arg_type = O_LIST;
  1029.     arg->arg_len = i;
  1030.     return arg;
  1031. }
  1032.  
  1033. /* turn a single item into a list */
  1034.  
  1035. ARG *
  1036. listish(arg)
  1037. ARG *arg;
  1038. {
  1039.     if (arg && arg->arg_flags & AF_LISTISH)
  1040.     arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
  1041.     return arg;
  1042. }
  1043.  
  1044. ARG *
  1045. maybelistish(optype, arg)
  1046. int optype;
  1047. ARG *arg;
  1048. {
  1049.     ARG *tmparg = arg;
  1050.  
  1051.     if (optype == O_RETURN && arg->arg_type == O_ITEM &&
  1052.       arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
  1053.       ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
  1054.     tmparg = listish(tmparg);
  1055.     free_arg(arg);
  1056.     arg = tmparg;
  1057.     }
  1058.     else if (optype == O_PRTF ||
  1059.       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
  1060.        arg->arg_type == O_F_OR_R) )
  1061.     arg = listish(arg);
  1062.     return arg;
  1063. }
  1064.  
  1065. /* mark list of local variables */
  1066.  
  1067. ARG *
  1068. localize(arg)
  1069. ARG *arg;
  1070. {
  1071.     arg->arg_flags |= AF_LOCAL;
  1072.     return arg;
  1073. }
  1074.  
  1075. ARG *
  1076. rcatmaybe(arg)
  1077. ARG *arg;
  1078. {
  1079.     ARG *arg2;
  1080.  
  1081.     if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
  1082.     arg2 = arg[2].arg_ptr.arg_arg;
  1083.     if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
  1084.         arg->arg_type = O_RCAT;    
  1085.         arg[2].arg_type = arg2[1].arg_type;
  1086.         arg[2].arg_ptr = arg2[1].arg_ptr;
  1087.         free_arg(arg2);
  1088.     }
  1089.     }
  1090.     return arg;
  1091. }
  1092.  
  1093. ARG *
  1094. stab2arg(atype,stab)
  1095. int atype;
  1096. register STAB *stab;
  1097. {
  1098.     register ARG *arg;
  1099.  
  1100.     arg = op_new(1);
  1101.     arg->arg_type = O_ITEM;
  1102.     arg[1].arg_type = atype;
  1103.     arg[1].arg_ptr.arg_stab = stab;
  1104.     return arg;
  1105. }
  1106.  
  1107. ARG *
  1108. cval_to_arg(cval)
  1109. register char *cval;
  1110. {
  1111.     register ARG *arg;
  1112.  
  1113.     arg = op_new(1);
  1114.     arg->arg_type = O_ITEM;
  1115.     arg[1].arg_type = A_SINGLE;
  1116.     arg[1].arg_ptr.arg_str = str_make(cval,0);
  1117.     Safefree(cval);
  1118.     return arg;
  1119. }
  1120.  
  1121. ARG *
  1122. op_new(numargs)
  1123. int numargs;
  1124. {
  1125.     register ARG *arg;
  1126.  
  1127.     Newz(203,arg, numargs + 1, ARG);
  1128.     arg->arg_ptr.arg_str = Str_new(21,0);
  1129.     arg->arg_len = numargs;
  1130.     return arg;
  1131. }
  1132.  
  1133. void
  1134. free_arg(arg)
  1135. ARG *arg;
  1136. {
  1137.     str_free(arg->arg_ptr.arg_str);
  1138.     Safefree(arg);
  1139. }
  1140.  
  1141. ARG *
  1142. make_match(type,expr,spat)
  1143. int type;
  1144. ARG *expr;
  1145. SPAT *spat;
  1146. {
  1147.     register ARG *arg;
  1148.  
  1149.     arg = make_op(type,2,expr,Nullarg,Nullarg);
  1150.  
  1151.     arg[2].arg_type = A_SPAT|A_DONT;
  1152.     arg[2].arg_ptr.arg_spat = spat;
  1153. #ifdef DEBUGGING
  1154.     if (debug & 16)
  1155.     fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
  1156. #endif
  1157.  
  1158.     if (type == O_SUBST || type == O_NSUBST) {
  1159.     if (arg[1].arg_type != A_STAB) {
  1160.         yyerror("Illegal lvalue");
  1161.     }
  1162.     arg[1].arg_type = A_LVAL;
  1163.     }
  1164.     return arg;
  1165. }
  1166.  
  1167. ARG *
  1168. cmd_to_arg(cmd)
  1169. CMD *cmd;
  1170. {
  1171.     register ARG *arg;
  1172.  
  1173.     arg = op_new(1);
  1174.     arg->arg_type = O_ITEM;
  1175.     arg[1].arg_type = A_CMD;
  1176.     arg[1].arg_ptr.arg_cmd = cmd;
  1177.     return arg;
  1178. }
  1179.  
  1180. /* Check two expressions to see if there is any identifier in common */
  1181.  
  1182. static int
  1183. nothing_in_common(arg1,arg2)
  1184. ARG *arg1;
  1185. ARG *arg2;
  1186. {
  1187.     static int thisexpr = 0;    /* I don't care if this wraps */
  1188.  
  1189.     thisexpr++;
  1190.     if (arg_common(arg1,thisexpr,1))
  1191.     return 0;    /* hit eval or do {} */
  1192.     stab_lastexpr(defstab) = thisexpr;        /* pretend to hit @_ */
  1193.     if (arg_common(arg2,thisexpr,0))
  1194.     return 0;    /* hit identifier again */
  1195.     return 1;
  1196. }
  1197.  
  1198. /* Recursively descend an expression and mark any identifier or check
  1199.  * it to see if it was marked already.
  1200.  */
  1201.  
  1202. static int
  1203. arg_common(arg,exprnum,marking)
  1204. register ARG *arg;
  1205. int exprnum;
  1206. int marking;
  1207. {
  1208.     register int i;
  1209.  
  1210.     if (!arg)
  1211.     return 0;
  1212.     for (i = arg->arg_len; i >= 1; i--) {
  1213.     switch (arg[i].arg_type & A_MASK) {
  1214.     case A_NULL:
  1215.         break;
  1216.     case A_LEXPR:
  1217.     case A_EXPR:
  1218.         if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
  1219.         return 1;
  1220.         break;
  1221.     case A_CMD:
  1222.         return 1;        /* assume hanky panky */
  1223.     case A_STAR:
  1224.     case A_LSTAR:
  1225.     case A_STAB:
  1226.     case A_LVAL:
  1227.     case A_ARYLEN:
  1228.     case A_LARYLEN:
  1229.         if (marking)
  1230.         stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
  1231.         else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
  1232.         return 1;
  1233.         break;
  1234.     case A_DOUBLE:
  1235.     case A_BACKTICK:
  1236.         {
  1237.         register char *s = arg[i].arg_ptr.arg_str->str_ptr;
  1238.         register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
  1239.         register STAB *stab;
  1240.  
  1241.         while (*s) {
  1242.             if (*s == '$' && s[1]) {
  1243.             s = scanident(s,send,tokenbuf);
  1244.             stab = stabent(tokenbuf,TRUE);
  1245.             if (marking)
  1246.                 stab_lastexpr(stab) = exprnum;
  1247.             else if (stab_lastexpr(stab) == exprnum)
  1248.                 return 1;
  1249.             continue;
  1250.             }
  1251.             else if (*s == '\\' && s[1])
  1252.             s++;
  1253.             s++;
  1254.         }
  1255.         }
  1256.         break;
  1257.     case A_SPAT:
  1258.         if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
  1259.         return 1;
  1260.         break;
  1261.     case A_READ:
  1262.     case A_INDREAD:
  1263.     case A_GLOB:
  1264.     case A_WORD:
  1265.     case A_SINGLE:
  1266.         break;
  1267.     }
  1268.     }
  1269.     switch (arg->arg_type) {
  1270.     case O_ARRAY:
  1271.     case O_LARRAY:
  1272.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1273.         (void)aadd(arg[1].arg_ptr.arg_stab);
  1274.     break;
  1275.     case O_HASH:
  1276.     case O_LHASH:
  1277.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1278.         (void)hadd(arg[1].arg_ptr.arg_stab);
  1279.     break;
  1280.     case O_EVAL:
  1281.     case O_SUBR:
  1282.     case O_DBSUBR:
  1283.     return 1;
  1284.     }
  1285.     return 0;
  1286. }
  1287.  
  1288. static int
  1289. spat_common(spat,exprnum,marking)
  1290. register SPAT *spat;
  1291. int exprnum;
  1292. int marking;
  1293. {
  1294.     if (spat->spat_runtime)
  1295.     if (arg_common(spat->spat_runtime,exprnum,marking))
  1296.         return 1;
  1297.     if (spat->spat_repl) {
  1298.     if (arg_common(spat->spat_repl,exprnum,marking))
  1299.         return 1;
  1300.     }
  1301.     return 0;
  1302. }
  1303.